6.2.1 Social Values

df1.hex <- h2o.importFile("C:/Jaspreet Marketing Analytics Project/EA 2020 Data/SocialValues_2020_fsaldu_06nov20.csv")

  |                                                                            
  |                                                                      |   0%
  |                                                                            
  |=================                                                     |  25%
  |                                                                            
  |===================================                                   |  50%
  |                                                                            
  |======================================================                |  77%
  |                                                                            
  |======================================================================| 100%

which( h2o.colnames(df1.hex ) == "SV00015") # Currently own - Smart phone

[1] 18

which( h2o.colnames(df1.hex ) == "SV00028") # Currently own - Smart phone

[1] 31

which( h2o.colnames(df1.hex ) == "CODE")

[1] 1

#which( h2o.colnames(df1.hex ) == "M2DC1") # Currently own - Smart phone
#which( h2o.colnames(df1.hex ) == "M224C45") # Currently own - Smart phone
#which( h2o.colnames(df1.hex ) == "M225C45") # Currently own - Smart phone

The code-chunk below extracts the high-potential basis variables into a smaller file.

df1s.hex<- as.h2o(df1.hex[, c(1,18,31)]) # copy selected columns to new dataframe
names(df1s.hex)

[1] "CODE"    "SV00015" "SV00028"

Since these files are so large, purge them from active duty after extracting the key variables.

rm(df1.hex) # remove objects you won't use again to free up space

6.2.2 DemoStats

Just repeat the same sequence of operations on each of the remaining data files.

df2.hex<-h2o.importFile("C:/Jaspreet Marketing Analytics Project/EA 2020 Data/DemoStats2020_fsaldu_05nov20.csv")

  |                                                                            
  |                                                                      |   0%
  |                                                                            
  |===============================                                       |  44%
  |                                                                            
  |================================================                      |  69%
  |                                                                            
  |================================================================      |  92%
  |                                                                            
  |======================================================================| 100%

which( h2o.colnames(df2.hex ) == "CODE")

[1] 1

which( h2o.colnames(df2.hex ) == "ECYBASPOP")

[1] 5

which( h2o.colnames(df2.hex ) == "ECYPTAMED") # Currently own - Smart phone

[1] 42

which( h2o.colnames(df2.hex ) == "ECYPMAMED")

[1] 63

which( h2o.colnames(df2.hex ) == "ECYPFAMED")

[1] 84

which( h2o.colnames(df2.hex ) == "ECYHSZAVG")

[1] 165

which( h2o.colnames(df2.hex ) == "ECYHTYFHT")

[1] 167

which( h2o.colnames(df2.hex ) == "ECYHTYNFH")

[1] 170

which( h2o.colnames(df2.hex ) == "ECYCHAFHCH")

[1] 255

which( h2o.colnames(df2.hex ) == "ECYSTYHOUS")

[1] 274

which( h2o.colnames(df2.hex ) == "ECYSTYAPT")

[1] 278

which( h2o.colnames(df2.hex ) == "ECYCDOCO")

[1] 286

which( h2o.colnames(df2.hex ) == "ECYHNIMED")

[1] 323

which( h2o.colnames(df2.hex ) == "ECYEDUHSCE")

[1] 331

which( h2o.colnames(df2.hex ) == "ECYEDUCOLL")

[1] 333

which( h2o.colnames(df2.hex ) == "ECYEDUUD")

[1] 335

which( h2o.colnames(df2.hex ) == "ECYACTEMP")

[1] 349

which( h2o.colnames(df2.hex ) == "ECYACTUEMP")

[1] 350

which( h2o.colnames(df2.hex ) == "ECYTIMIMGT")

[1] 540

df2s.hex<- as.h2o(df2.hex[, c(1,5,42,63,84,165,167,170,255,274,278,286,323,331,333,335,349,350,540   )]) # copy selected columns to new dataframe
names(df2s.hex)

 [1] "CODE"       "ECYBASPOP"  "ECYPTAMED"  "ECYPMAMED"  "ECYPFAMED" 
 [6] "ECYHSZAVG"  "ECYHTYFHT"  "ECYHTYNFH"  "ECYCHAFHCH" "ECYSTYHOUS"
[11] "ECYSTYAPT"  "ECYCDOCO"   "ECYHNIMED"  "ECYEDUHSCE" "ECYEDUCOLL"
[16] "ECYEDUUD"   "ECYACTEMP"  "ECYACTUEMP" "ECYTIMIMGT"

rm(df2.hex) # remove objects you won't use again to free up space

6.2.3 Money Matters

df3.hex<-h2o.importFile("C:/Jaspreet Marketing Analytics Project/EA 2020 Data/MoneyMatters5_2020_fsaldu_06nov20.csv")

  |                                                                            
  |                                                                      |   0%
  |                                                                            
  |=============                                                         |  19%
  |                                                                            
  |===================================                                   |  50%
  |                                                                            
  |==========================================================            |  83%
  |                                                                            
  |======================================================================| 100%

which( h2o.colnames(df3.hex ) == "CFM0876I")

[1] 163

which( h2o.colnames(df3.hex ) == "CODE")# Currently own - Smart phone

[1] 1

df3s.hex<- as.h2o(df3.hex[, c(163,1   )]) # copy selected columns to new dataframe
names(df3s.hex)

[1] "CFM0876I" "CODE"    

rm(df3.hex) # remove objects you won't use again to free up space

6.2.4 Mobile 1

df4.hex<-h2o.importFile("C:/Jaspreet Marketing Analytics Project/EA 2020 Data/Mobile1_2020_fsaldu_06nov20.csv")

  |                                                                            
  |                                                                      |   0%
  |                                                                            
  |============================================================          |  85%
  |                                                                            
  |======================================================================| 100%

which( h2o.colnames(df4.hex ) == "M221C45")

[1] 41

which( h2o.colnames(df4.hex ) == "M222C45")

[1] 42

which( h2o.colnames(df4.hex ) == "M3F3C3")# Currently own - Smart phone

[1] 87

which( h2o.colnames(df4.hex ) == "CODE")

[1] 1

df4s.hex<- as.h2o(df4.hex[, c(1,41,42,87)]) # copy selected columns to new dataframe
names(df4s.hex)

[1] "CODE"    "M221C45" "M222C45" "M3F3C3" 

rm(df4.hex) # remove objects you won't use again to free up space

6.2.5 Mobile 2

df5.hex<-h2o.importFile("C:/Jaspreet Marketing Analytics Project/EA 2020 Data/Mobile2_2020_fsaldu_06nov20.csv")

  |                                                                            
  |                                                                      |   0%
  |                                                                            
  |====================================                                  |  52%
  |                                                                            
  |======================================================================| 100%

which( h2o.colnames(df5.hex ) == "M2X33C31")

[1] 20

which( h2o.colnames(df5.hex ) == "M2X32C32")

[1] 21

which( h2o.colnames(df5.hex ) == "M2X33C33")

[1] 22

which( h2o.colnames(df5.hex ) == "M2X33C34")

[1] 23

which( h2o.colnames(df5.hex ) == "M2Y33C31")

[1] 47

which( h2o.colnames(df5.hex ) == "M2Y32C32")

[1] 48

which( h2o.colnames(df5.hex ) == "M2Y33C33")

[1] 49

which( h2o.colnames(df5.hex ) == "M2Y33C34")

[1] 50

which( h2o.colnames(df5.hex ) == "CODE")# Currently own - Smart phone

[1] 1

df5s.hex<- as.h2o(df5.hex[, c(1,20,21,22,23,47,48,49,50)]) # copy selected columns to new dataframe
names(df5s.hex)

[1] "CODE"     "M2X33C31" "M2X32C32" "M2X33C33" "M2X33C34" "M2Y33C31" "M2Y32C32"
[8] "M2Y33C33" "M2Y33C34"

rm(df5.hex) # remove objects you won't use again to free up space

6.2.6 Mobile6

df6.hex<-h2o.importFile("C:/Jaspreet Marketing Analytics Project/EA 2020 Data/Mobile6_2020_fsaldu_06nov20.csv")

  |                                                                            
  |                                                                      |   0%
  |                                                                            
  |======================================================================| 100%

which( h2o.colnames(df6.hex ) == "M3Q241C45")

[1] 79

which( h2o.colnames(df6.hex ) == "CODE")# Maps/navigation apps - Trust

[1] 1

df6s.hex<- as.h2o(df6.hex[, c(1,79)]) # copy selected columns to new dataframe
h2o.names(df6s.hex)

[1] "CODE"      "M3Q241C45"

rm(df6.hex) # remove objects you won't use again to free up space

6.5.1 Reading in the Data

Initially we started with reading in the variables from our CSV File.

fs1 <- read.csv("C:/Jaspreet Marketing Analytics Project/Project_Merged_File.csv")

6.5.2 Missing Values : XRAY

One of the most difficult realities of working with data is missing values. Through using the xray package, there were no missing values to deal with.

xray::anomalies(fs1)

$variables
                 Variable      q qNA pNA  qZero  pZero qBlank pBlank qInf pInf
1                  Condos 252726   0   - 183834 72.74%      0      -    0    -
2                     Apt 252726   0   - 105463 41.73%      0      -    0    -
3                   UnEmp 252726   0   - 100598 39.81%      0      -    0    -
4              X._NF_Hhld 252726   0   -  29148 11.53%      0      -    0    -
5                 Tot_Mig 252726   0   -  21665  8.57%      0      -    0    -
6               F_Pop_Age 252726   0   -  19015  7.52%      0      -    0    -
7        Uni_Dip_Blw_Bach 252726   0   -  18712   7.4%      0      -    0    -
8   Clg_CEGEP_Non_Uni_Dip 252726   0   -   8413  3.33%      0      -    0    -
9                  Houses 252726   0   -   5755  2.28%      0      -    0    -
10 Avg_Chld_PrCen_Fm_Hhld 252726   0   -   4553   1.8%      0      -    0    -
11            High.School 252726   0   -   3863  1.53%      0      -    0    -
12              M_Pop_Age 252726   0   -   2927  1.16%      0      -    0    -
13            X._Fam_Hhld 252726   0   -   1328  0.53%      0      -    0    -
14                   Empl 252726   0   -    172  0.07%      0      -    0    -
15          X.Smt_Hm_Secu 252726   0   -    105  0.04%      0      -    0    -
16      X.Smt_Hm_Asst.Pln 252726   0   -     23  0.01%      0      -    0    -
17       X.Smt_Hm_Sec.Pln 252726   0   -     22  0.01%      0      -    0    -
18       X.Smat_Therm.Pln 252726   0   -      3     0%      0      -    0    -
19       X.Smt_Hm_Dev.Pln 252726   0   -      3     0%      0      -    0    -
20            X._Pvt_HHld 252726   0   -      0      -      0      -    0    -
21                Pop_Age 252726   0   -      0      -      0      -    0    -
22              Total_Pop 252726   0   -      0      -      0      -    0    -
23             Confidence 252726   0   -      0      -      0      -    0    -
24            Tech.Enthu. 252726   0   -      0      -      0      -    0    -
25       Ann_Prem_Hm_Insu 252726   0   -      0      -      0      -    0    -
26          Mob_Mark_cons 252726   0   -      0      -      0      -    0    -
27       Mob_Inf_sec_cons 252726   0   -      0      -      0      -    0    -
28             Smt_Hm_Dev 252726   0   -      0      -      0      -    0    -
29           Fin_App_Trst 252726   0   -      0      -      0      -    0    -
30           X.Smt_Hm_Ass 252726   0   -      0      -      0      -    0    -
31         X..Smart_purch 252726   0   -      0      -      0      -    0    -
32            X.Smt_Therm 252726   0   -      0      -      0      -    0    -
33            Hhld.Income 252726   0   -      0      -      0      -    0    -
34                   CODE 252726   0   -      0      -      0      -    0    -
   qDistinct      type anomalous_percent
1       7567   Numeric            72.74%
2      10390   Numeric            41.73%
3       5136   Numeric            39.81%
4        479   Integer            11.53%
5      11811   Numeric             8.57%
6        723   Numeric             7.52%
7      10293   Numeric              7.4%
8       7046   Numeric             3.33%
9       8719   Numeric             2.28%
10        48   Numeric              1.8%
11      7634   Numeric             1.53%
12       668   Numeric             1.16%
13       804   Integer             0.53%
14     10525   Numeric             0.07%
15     48765   Numeric             0.04%
16     44903   Numeric             0.01%
17     48552   Numeric             0.01%
18     44468   Numeric                0%
19     45573   Numeric                0%
20       104   Numeric                 -
21       670   Numeric                 -
22      1608   Integer                 -
23     39750   Numeric                 -
24     39750   Numeric                 -
25     43899   Numeric                 -
26     44181   Numeric                 -
27     45403   Numeric                 -
28     48251   Numeric                 -
29     48628   Numeric                 -
30     49279   Numeric                 -
31     49827   Numeric                 -
32     54767   Numeric                 -
33    140106   Numeric                 -
34    252726 Character                 -

$problem_variables
 [1] Variable          q                 qNA               pNA              
 [5] qZero             pZero             qBlank            pBlank           
 [9] qInf              pInf              qDistinct         type             
[13] anomalous_percent problems         
<0 rows> (or 0-length row.names)

6.6.1 A 2 Segment Solution

Level 1 segmentation begins with a two-cluster solution and then moves ahead to 3 segments and so on until useful options were been identified. Two segments is just a first guess.

The dfK variable below holds the sums of squares for each segmentation solution. One key objective of segmentation is to maximize the differences among segments while having individuals within each segment to be very close. That translates into maximizing the between segments sum-of-squares and minimizing the within segments sums-of-squares.

dfK <- data.frame(Numbr_Segments=numeric(),
                  TotWithinSS=numeric(),
                  BetweenSS=numeric(),
                  TotSS=numeric(),
                  stringsAsFactors=FALSE) 

This code-chunk conducts the k-means analysis in h2o on all attitude variables. Using the variables, we wanted to see if they could help us partition the dataset into sections or clusters that are distinct from one another.

k_iterations = 2  
fs.km2 <- h2o.kmeans(fs.class[, 1:15], k = k_iterations, estimate_k = TRUE, 
                   init=c("PlusPlus"), standardize= FALSE,
                   score_each_iteration= FALSE, seed = 7238,
                   keep_cross_validation_predictions=TRUE)

The following code-chunk saves key information from this solution in the dfK receptacle so that a comparative table can be produced when all rounds of partitioning are finished. The dfk object holds the number of iterations ‘within sum of squares’ (which we’re looking at minimizing) the ‘between sum of squares (which we’re looking at maximizing) and the ’total sum of squares’ (which will always be the same).

dfK[k_iterations-1,1] <- k_iterations
dfK[k_iterations-1,2] <- getTotWithinSS(fs.km2) # within segment sums of squares
dfK[k_iterations-1,3] <- getBetweenSS(fs.km2)   # between segments sums of squares
dfK[k_iterations-1,4] <- getTotSS(fs.km2)       # total sums of squares

Out of this two-segment k means (i.e. the segmentation clusters), there is 96002in one cluster and 156724 in the second cluster. They are uneven, but it’s nothing to be concerned about. With additial segments, hopefully they evenout more.

h2o.cluster_sizes(fs.km2) # sizes of the segmentation clusters 

[1]  96002 156724

The following presents only cluster means, with centroid numbering for the variables. For example, the mean for variable “confidence” for segment 1 is 0.252506 and for segment 2 is 0.209111.

fs.km2@model$centers   

Cluster Means: 
  centroid confidence techenthu ann_prem_hm_insu mob_mark_cons mob_inf_sec_cons
1        1   0.252506  0.251570         0.189596      0.147918         0.196269
2        2   0.209111  0.200449         0.236151      0.126548         0.175912
  xsmart_purch xsmt_therm xsmt_hm_secu xsmt_hm_ass smt_hm_dev xsmat_thermpln
1     0.184659   0.243259     0.117882    0.247712   0.150620       0.110301
2     0.124040   0.154800     0.062937    0.183209   0.096768       0.085782
  xsmt_hm_secpln xsmt_hm_asstpln xsmt_hm_devpln fin_app_trst
1       0.145282        0.098794       0.120587     0.448208
2       0.092458        0.068352       0.085364     0.428726

Using ggplot, a plot of the centroids for the 2 segments over all used variables was created. You’ll notice that there is no ‘layering’ between the two segments in the centroid means plot. There is some cross over, which helps with describing persona profiles. We know that further segmentation willl yield better results, therefore we have stopped investing the 2 segment solution and have moved on to 3 segment clustering below this plot.

library(reshape2) # it's necessary to reshape the data into 'long' format
fs2c_long<- melt(fs.km2@model$centers ) # need to reshape to 'long' form
library(ggplot2)
ggplot(data=fs2c_long, aes(x=variable, y=value, group=centroid)) +
  geom_line(aes( color= centroid ), size=1.2)+
  geom_point(aes( color= centroid ), size=3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size=14)) +
  labs( title= "Centroids (means) of Segments over Basis Variables", 
        x= "Basis Variables", y= "Means (0-0.45)") + 
  ylim(0, 0.45) +
  annotate("text", x = 3, y = 1, label = "Base = 1036", size=4)  

6.6.2 A 3 segment solution

This code-chunk just changes the k-means command to 3 iterations, i.e., 3 segments. fs.km3 is the solution for 3 segments.

k_iterations = 3 
fs.km3 <- h2o.kmeans( fs.class[,1:15], k=k_iterations, estimate_k = TRUE, 
                   init=c("PlusPlus"), standardize= FALSE,
                   score_each_iteration= FALSE, seed = 7238,
                   keep_cross_validation_predictions=TRUE )

The sizes of the three segmentation clusters are below. The sizes are now a lot more even at : 81147, 81866, and 89713.

dfK[k_iterations-1,1] <- k_iterations
dfK[k_iterations-1,2] <- getTotWithinSS(fs.km3) # within segment sums of squares
dfK[k_iterations-1,3] <- getBetweenSS(fs.km3)   # between segments sums of squares
dfK[k_iterations-1,4] <- getTotSS(fs.km3)       # total sums of squares

Sizes of the segmentation clusters & cluster means, with centroid numbering is below.

h2o.cluster_sizes(fs.km3) # sizes of the segmentation clusters

[1] 81147 81866 89713

fs.km3@model$centers

Cluster Means: 
  centroid confidence techenthu ann_prem_hm_insu mob_mark_cons mob_inf_sec_cons
1        1   0.256710  0.253889         0.179860      0.148702         0.195111
2        2   0.199922  0.196589         0.189364      0.122409         0.167667
3        3   0.220600  0.210086         0.279686      0.133024         0.187692
  xsmart_purch xsmt_therm xsmt_hm_secu xsmt_hm_ass smt_hm_dev xsmat_thermpln
1     0.188097   0.250251     0.123119    0.250546   0.153713       0.110484
2     0.122583   0.143535     0.060426    0.170710   0.089837       0.079019
3     0.132027   0.172913     0.069328    0.202337   0.108916       0.095679
  xsmt_hm_secpln xsmt_hm_asstpln xsmt_hm_devpln fin_app_trst
1       0.149757        0.101535       0.123214     0.441721
2       0.086693        0.065728       0.078356     0.396296
3       0.102135        0.073150       0.094995     0.467023

The following plot of the centroids for the 3 segments is slightly more interesting than was the 2-segment solution but we can still need to push further. Some initial observations:

• Segment 1 are the technophiles. They own a lot of smart technology and also plan on purchasing more. This segment is high on having enthusiasm for technology and are trusting of big businesses.
• Segment 2 are the least technologically-enabled out of the three segments. They do, however pay higher premiums for home insurance than Segment 1, the technophiles.
• Segment 3 is interesting because they pay the highest home insurance premiums by a long shot, but don’t own a lot of smart home technology. It will be interesting to see the level 2 segmentation, because these individuals may be older, have more money and thus larger more expensive houses that have higher premiums, but because they’re older, they may be somewhat technologically-disabled.

Below the plot, we have decided to push further with a 4-Segment Solution.

fs3c_long<- melt(fs.km3@model$centers ) # need to reshape to 'long' form
 
ggplot(data=fs3c_long, aes(x=variable, y=value, group=centroid)) +
  geom_line(aes( color= centroid ), size=1.2)+
  geom_point(aes( color= centroid ), size=3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size=14)) +
  labs( title= "Centroids (means) of Segments over Basis Variables", 
        x= "Basis Variables", y= "Means (0-0.45)") + ylim(0,0.45) +
  annotate("text", x = 3, y = 1, label = "Base = 1036", size=4) 

6.6.3 A 4 segment solution

As usual, the clustering algorithm groups the respondents.

#____k-means clustering, k=4 clusters
k_iterations <- 4 # MAXIMUM NUMBER OF SEGMENTS USED HERE
fs.km4 <- h2o.kmeans(fs.class[,1:15], k=k_iterations, estimate_k = FALSE, 
                    init=c("PlusPlus"), standardize= FALSE,
                    score_each_iteration= FALSE, seed = 7238,
                    keep_cross_validation_predictions=TRUE) 

Saving the sums-of-squares to the dfK data frame.

dfK[k_iterations-1,1] <- k_iterations
dfK[k_iterations-1,2] <- getTotWithinSS(fs.km4) # within segment sums of squares
dfK[k_iterations-1,3] <- getBetweenSS(fs.km4)   # between segments sums of squares
dfK[k_iterations-1,4] <- getTotSS(fs.km4)       # total sums of squares 

The sizes of the four clusters are getting a little uneven again, but it’s nothing to be concerned about: 41569, 76774, 62595, and 71788.

h2o.cluster_sizes(fs.km4) # 

[1] 41569 76774 62595 71788

The cluster means, with centroid numbering, are provided below.

fs.km4@model$centers  

Cluster Means: 
  centroid confidence techenthu ann_prem_hm_insu mob_mark_cons mob_inf_sec_cons
1        1   0.201426  0.258592         0.161547      0.144135         0.208495
2        2   0.204561  0.181748         0.218850      0.117299         0.158659
3        3   0.267740  0.249957         0.179796      0.149719         0.190807
4        4   0.225678  0.212453         0.286128      0.134919         0.190283
  xsmart_purch xsmt_therm xsmt_hm_secu xsmt_hm_ass smt_hm_dev xsmat_thermpln
1     0.190667   0.147765     0.075679    0.193768   0.105557       0.093433
2     0.107581   0.150261     0.058678    0.171162   0.089400       0.078181
3     0.184109   0.265848     0.131476    0.258052   0.160900       0.111391
4     0.132095   0.185768     0.074036    0.211663   0.116090       0.100329
  xsmt_hm_secpln xsmt_hm_asstpln xsmt_hm_devpln fin_app_trst
1       0.098799        0.080699       0.101414     0.462595
2       0.086462        0.062731       0.075302     0.392077
3       0.159152        0.105840       0.127678     0.431884
4       0.108018        0.075420       0.097391     0.473106

This plot of the centroids for the 4 segments shows much greater complexity than did the earlier solutions. Some observations:

• Segment 1 is the second most important group for RBC to target, based on their enthusiasm for technology, smarthome technology adoption, and plans to purchase more smart home technology. The are not extreme technophiles like Segment 3, but are the second most technologically-enabled segment.
• Segment 2 is the lowest priority segment to market to given the context of RBCI’s goal of smart technology partnership and marketing.They have the lowest adoption of smart home technology and the lowest plans to purchase the technology in the future. this segment could in fact encompass an elderly population, but this of course would need to be confirmed in the level 2 segmentation.
• Segment 3 is now the technophile group, with the most amount of confidence in big businesses and
• Segment 4 is now the group that pays high insurance premiums, but is slow to smart home technology adoption.

Before looking at comparisons of the sums-of-squares, we have looked into a 5-segment solution.

library(reshape2) # it's necessary to reshape the data into 'long' format
fs4c_long<- melt(fs.km4@model$centers ) # need to reshape to 'long' form

library(ggplot2)
ggplot(data=fs4c_long, aes(x=variable, y=value, group=centroid)) +
  geom_line(aes( color= centroid ), size=1.2)+
  geom_point(aes( color= centroid ), size=3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size=14)) +
  labs( title= "Centroids (means) of Segments over Basis Variables", 
        x= "Basis Variables", y= "Means (0-0.5)") + ylim(0, 0.5) +
  annotate("text", x = 3, y = 1, label = "Base = 1036", size=4) 

### A 5 segment solution

As usual, the clustering algorithm groups the respondents.

k_iterations = 5
fs.km5<- h2o.kmeans(fs.class[,1:15], k=k_iterations, estimate_k = FALSE, 
                   init=c("PlusPlus"), standardize= FALSE,
                   score_each_iteration= FALSE, seed = 7238,
                   keep_cross_validation_predictions=TRUE) 

Saving the sums-of-squares to the dfk data frame

dfK[k_iterations-1,1] <- k_iterations
dfK[k_iterations-1,2] <- getTotWithinSS(fs.km5) # within segment sums of squares
dfK[k_iterations-1,3] <- getBetweenSS(fs.km5)   # between segments sums of squares
dfK[k_iterations-1,4] <- getTotSS(fs.km5)       # total sums of squares

The sizes of the five clusters are getting a little uneven again, but it’s nothing to be concerned about: 28435 55811 37787 68582 and 62111.

h2o.cluster_sizes(fs.km5) # 

[1] 28435 55811 37787 68582 62111

The Cluster means with centroid numbering are below.

fs.km5@model$centers   

Cluster Means: 
  centroid confidence techenthu ann_prem_hm_insu mob_mark_cons mob_inf_sec_cons
1        1   0.196001  0.256632         0.159647      0.149405         0.217220
2        2   0.226635  0.207035         0.302774      0.133919         0.189772
3        3   0.286595  0.254967         0.169591      0.157873         0.193669
4        4   0.202890  0.180364         0.214557      0.116860         0.157771
5        5   0.227482  0.237932         0.202917      0.134659         0.185620
  xsmart_purch xsmt_therm xsmt_hm_secu xsmt_hm_ass smt_hm_dev xsmat_thermpln
1     0.200842   0.125183     0.067929    0.185842   0.099148       0.089929
2     0.123966   0.171386     0.066838    0.202734   0.106343       0.097778
3     0.196887   0.279565     0.146351    0.271448   0.169732       0.117141
4     0.106023   0.146765     0.057151    0.168893   0.087195       0.077218
5     0.159467   0.225617     0.099206    0.227997   0.137927       0.102015
  xsmt_hm_secpln xsmt_hm_asstpln xsmt_hm_devpln fin_app_trst
1       0.091335        0.080756       0.103926     0.476561
2       0.103691        0.074386       0.097439     0.476269
3       0.174145        0.117362       0.141742     0.432556
4       0.084650        0.061744       0.074103     0.389897
5       0.124923        0.082604       0.099543     0.435099

This plot of the centroids for the 5 segments shows much greater complexity than did the earlier solutions. Perhaps too much complexity. The segments are getting harder to differentiate because there is so much overlap.

library(reshape2) # it's necessary to reshape the data into 'long' format
fs5c_long<- melt(fs.km5@model$centers ) # need to reshape to 'long' form

library(ggplot2)
ggplot(data=fs5c_long, aes(x=variable, y=value, group=centroid)) +
  geom_line(aes( color= centroid ), size=1.2)+
  geom_point(aes( color= centroid ), size=3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size=14)) +
  labs( title= "Centroids (means) of Segments over Basis Variables", 
        x= "Basis Variables", y= "Means (0-0.6)") + 
  ylim(0,0.6) +
  annotate("text", x = 3, y = 1, label = "Base = 1036", size=4)  

Now let’s look at comparison among the sums-of-squares information to help determine the number of segments to investigate further. The 5-segment solution has the highest between segment sums-of-squares.

pacman::p_load(sjPlot)
tab_df(dfK, sort.column = -3, show.rownames = FALSE, 
       title = "Sums of Squares for Level 1 Segmentation", digits=2)

Before looking at comparisons of the sums-of-squares, we have looked into a 6-segment solution.

6.6.4 A 6 segment solution

As usual, the clustering algorithm groups the respondents.

k_iterations <- 6
fs.km6<- h2o.kmeans(fs.class[,1:15], k=k_iterations, estimate_k = FALSE, 
                   init=c("PlusPlus"), standardize= FALSE,
                   score_each_iteration= FALSE, seed = 7238,
                   keep_cross_validation_predictions=TRUE) 

Saving the sums-of-squares to the dfK data frame.

dfK[k_iterations-1,1] <- k_iterations
dfK[k_iterations-1,2] <- getTotWithinSS(fs.km6) # within segment sums of squares
dfK[k_iterations-1,3] <- getBetweenSS(fs.km6)   # between segments sums of squares
dfK[k_iterations-1,4] <- getTotSS(fs.km6)       # total sums of squares

The sizes of the six clusters are getting a little uneven again, but it’s nothing to be concerned about : 26635 58409 34745 61340 42733 & 28864

h2o.cluster_sizes(fs.km6) 

[1] 26635 58409 34745 61340 42733 28864

The cluster means with centroid numbering, are provided below..

fs.km6@model$centers 

Cluster Means: 
  centroid confidence techenthu ann_prem_hm_insu mob_mark_cons mob_inf_sec_cons
1        1   0.191754  0.256654         0.160416      0.149149         0.217835
2        2   0.213186  0.208622         0.246539      0.132280         0.180940
3        3   0.281919  0.250519         0.176070      0.159439         0.196190
4        4   0.202426  0.178207         0.214629      0.115948         0.156440
5        5   0.245322  0.254933         0.179780      0.134451         0.183664
6        6   0.236315  0.207693         0.338468      0.137530         0.201611
  xsmart_purch xsmt_therm xsmt_hm_secu xsmt_hm_ass smt_hm_dev xsmat_thermpln
1     0.204414   0.124788     0.067997    0.186497   0.099902       0.088469
2     0.131895   0.195959     0.078413    0.214738   0.121044       0.098349
3     0.199055   0.287712     0.147283    0.277895   0.174777       0.116015
4     0.103886   0.141856     0.055007    0.165026   0.084133       0.075502
5     0.164899   0.224125     0.105452    0.223130   0.135033       0.104734
6     0.127743   0.160589     0.062986    0.198947   0.101528       0.097754
  xsmt_hm_secpln xsmt_hm_asstpln xsmt_hm_devpln fin_app_trst
1       0.089631        0.079154       0.103678     0.479893
2       0.105739        0.071653       0.090768     0.454770
3       0.173174        0.114121       0.141037     0.444190
4       0.082964        0.061023       0.073132     0.387059
5       0.135375        0.093152       0.107180     0.413531
6       0.104794        0.077433       0.102914     0.490498

This plot of the centroids for the 6 segments shows much greater complexity than did the earlier solutions. Perhaps too much complexity. The segments are getting harder to differentiate because there is so much overlap.

fs6c_long<- melt(fs.km6@model$centers ) # need to reshape to 'long' form

ggplot(data=fs6c_long, aes(x=variable, y=value, group=centroid)) +
  geom_line(aes( color= centroid ), size=1.2)+
  geom_point(aes( color= centroid ), size=3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1, size=14)) +
  labs( title= "Centroids (means) of Segments over Basis Variables", 
        x= "Basis Variables", y= "Means (0-0.55)") + ylim(0, 0.55) +
  annotate("text", x = 3, y = 1, label = "Base = 1036", size=4)  

Having done the 1 Segment to 6 Segment Solutions, we have plotted their sums-of-squares information to help determine the number of segments to investigate further. With the addition of each segment the WithinSS decreases, and the BetweenSS increases, which is what we want to happen. The 6 segment solution has the lowest WithinSS and the highest Between SS. However, the rate of change for the WithinSS and BetweenSS drastically declined for the 6 Segment Solution. The 6 Segment Solution’s plot of centroid means
was also difficult to create differentiated personas out of. The lines are not that separated from each other, thus the segments aren’t that different. The 4th segment plot seemed to be the best from an interpretation standpoint, and it was therefore futher investigated.

tab_df(dfK, sort.column = -3, show.rownames = FALSE, title = "Sums of Squares for Level 1 Segmentation", digits=2)

The graph below may provide a very rough guide for the number of segments, but is not definitive. The best number of segments may be where there is an elbow in the curve. An elbow seems to be placed at the ______ Segment Solution with diminishing returns (i.e. decreases) after it, but the 5-segment solution still increases the distances between segments and reduces the distances within segments.We know from the ggplot above that the 3 segment solution is not sufficient, which is why we stress that the ‘elbow’ guideline is simply a guideline

library(plotly)
dfK_melt <- melt(dfK, id=c("Numbr_Segments"))

p <- ggplot(data = dfK_melt, aes(x = Numbr_Segments, y = value)) +
  geom_point(aes(), size = 4) +
  geom_line(aes(colour = variable ), size=2) + facet_wrap(~ variable)+
  labs(x="Numbers of segments", y="Sums of squares") +
  theme(axis.title.x=element_text(size=16, face="bold", colour="blue")) +
  theme(axis.title.y=element_text(size=16, face="bold", colour="blue")) +
  theme(axis.text.x=element_text(size=14, face="bold" )) +
  theme(axis.text.y=element_text(size=14, face="bold" ))  +
  ggtitle("Cluster statistics") + theme(legend.position="none") 
(gg <- ggplotly(p)) 

6.6.5 Building Predictive Models That Predict Segment Accuracy

We have used Random Forest, GBM, logistic regression to predict segment accuracy obtained using K-means.

clusters.hex <- h2o.predict(fs.km4, fs.class) 
clusters.hex <- as.factor(clusters.hex) # cluster 'names' must be factors for modeling

clusters.hex$predict # segment assignments for first 6 respondents of 1036

h2o.table(clusters.hex$predict) # table of assignments over all respondents 

  predict Count
1       0 41569
2       1 76774
3       2 62595
4       3 71788

[4 rows x 2 columns] 

h2o.setLevels(clusters.hex$predict, c("Seg1","Seg2","Seg3","Seg4"))

  predict
1    Seg2
2    Seg2
3    Seg2
4    Seg2
5    Seg2
6    Seg2

[252726 rows x 1 column] 

#__Bind RID, predicted segments, and fs variables
fs4C.class<- h2o.cbind(fs.class[,c(1)], clusters.hex$predict, fs.class[, c(2:33)])
fs4C.class <- fs4C.class[, c(1:34)] # reorganize the data frame

h2o.table(clusters.hex$predict) 

  predict Count
1    Seg1 41569
2    Seg2 76774
3    Seg3 62595
4    Seg4 71788

[4 rows x 2 columns] 

h2o.exportFile(fs4C.class, 
    "C:/Jaspreet Marketing Analytics Project/FS_4.csv", force=TRUE) # save the results 

fs.split<- h2o.splitFrame(fs4C.class, ratios=c(0.7) )
fs.split[[1]]  

   Confidence predict Tech.Enthu. Ann_Prem_Hm_Insu Mob_Mark_cons
1 0.009426962    Seg2 0.009739573      0.004403856   0.005647059
2 0.025949382    Seg2 0.014750739      0.005865521   0.012673267
3 0.025238024    Seg2 0.029873820      0.020744546   0.015555556
4 0.030433902    Seg2 0.028479670      0.009048419   0.018765432
5 0.056125319    Seg2 0.061331941      0.063795120   0.030182927
6 0.076100931    Seg2 0.039830300      0.092729259   0.022857143
  Mob_Inf_sec_cons X..Smart_purch X.Smt_Therm X.Smt_Hm_Secu X.Smt_Hm_Ass
1      0.007529412    0.007152941 0.009788235   0.004517647   0.01204706
2      0.021386139    0.014257426 0.022178218   0.007128713   0.02534653
3      0.025555556    0.018888889 0.028888889   0.012222222   0.03222222
4      0.027654321    0.024691358 0.023703704   0.011851852   0.02666667
5      0.028170732    0.024146341 0.042256098   0.012073171   0.03823171
6      0.028571429    0.012857143 0.018571429   0.005714286   0.02000000
   Smt_Hm_Dev X.Smat_Therm.Pln X.Smt_Hm_Sec.Pln X.Smt_Hm_Asst.Pln
1 0.007152941      0.004517647      0.007905882       0.002635294
2 0.011881188      0.011089109      0.012673267       0.005544554
3 0.018888889      0.011111111      0.018888889       0.011111111
4 0.018765432      0.017777778      0.021728395       0.012839506
5 0.024146341      0.032195122      0.028170732       0.034207317
6 0.012857143      0.011428571      0.011428571       0.012857143
  X.Smt_Hm_Dev.Pln Fin_App_Trst   CODE Pop_Age M_Pop_Age F_Pop_Age X._Pvt_HHld
1      0.004141176   0.01882353 K7L5R2    41.8      42.1      15.0         6.0
2      0.011089109   0.04514852 K9V6H4    32.9      32.3      37.5        11.0
3      0.008888889   0.05666667 N2L2G4    84.3      83.6      85.0         7.0
4      0.015802469   0.05827160 M6B2P9    83.8      76.9      86.0        14.0
5      0.030182927   0.09054878 N7L5H5    76.8      74.0      78.1         3.6
6      0.010000000   0.07571429 K6H6X7    81.2      82.6      80.0         2.0
  X._Fam_Hhld X._NF_Hhld Avg_Chld_PrCen_Fm_Hhld      Houses         Apt
1           2          1                    3.0 0.002352941 0.002352941
2           1          0                    3.0 0.009900990 0.000000000
3           1          0                    2.0 0.027777778 0.000000000
4           1          0                    3.0 0.012345679 0.000000000
5           5          9                    2.4 0.085365854 0.000000000
6           1          0                    1.0 0.000000000 0.142857143
       Condos Hhld.Income High.School Clg_CEGEP_Non_Uni_Dip Uni_Dip_Blw_Bach
1 0.002352941    127.5026 0.007058824           0.009411765       0.01411765
2 0.000000000    905.8534 0.039603960           0.019801980       0.00000000
3 0.000000000   2407.2750 0.000000000           0.000000000       0.08333333
4 0.000000000   1764.7486 0.049382716           0.012345679       0.01234568
5 0.048780488    336.3186 0.091463415           0.000000000       0.07926829
6 0.000000000   9959.4643 0.142857143           0.000000000       0.00000000
        Empl       UnEmp    Tot_Mig
1 0.01176471 0.004705882 0.02352941
2 0.04950495 0.000000000 0.00990099
3 0.05555556 0.027777778 0.02777778
4 0.08641975 0.000000000 0.07407407
5 0.10365854 0.012195122 0.30487805
6 0.14285714 0.000000000 0.00000000

[176857 rows x 34 columns] 

fs.split[[2]] 

  Confidence predict Tech.Enthu. Ann_Prem_Hm_Insu Mob_Mark_cons
1 0.03188337    Seg2  0.02481761       0.01809865    0.01176471
2 0.05467271    Seg2  0.05312974       0.06034417    0.03090909
3 0.08517833    Seg2  0.10082414       0.09335045    0.04000000
4 0.10647280    Seg2  0.07367943       0.02017770    0.03656250
5 0.04973771    Seg2  0.05238778       0.02002063    0.03150000
6 0.10034801    Seg2  0.10569465       0.07024781    0.04342105
  Mob_Inf_sec_cons X..Smart_purch X.Smt_Therm X.Smt_Hm_Secu X.Smt_Hm_Ass
1       0.02705882     0.02117647  0.02823529   0.009411765   0.03529412
2       0.03272727     0.02181818  0.04545454   0.009090909   0.04181818
3       0.03750000     0.04250000  0.05500000   0.012500000   0.05000000
4       0.03937500     0.05062500  0.04781250   0.019687500   0.06187500
5       0.04050000     0.03150000  0.05100000   0.031500000   0.04350000
6       0.04342105     0.05500000  0.06368421   0.043421053   0.06368421
  Smt_Hm_Dev X.Smat_Therm.Pln X.Smt_Hm_Sec.Pln X.Smt_Hm_Asst.Pln
1 0.02000000       0.01647059       0.01411765        0.01529412
2 0.02909091       0.02909091       0.03272727        0.02181818
3 0.02000000       0.01500000       0.02500000        0.01000000
4 0.03937500       0.04218750       0.02531250        0.03656250
5 0.02850000       0.02550000       0.02400000        0.02250000
6 0.03473684       0.04052632       0.05210526        0.04921053
  X.Smt_Hm_Dev.Pln Fin_App_Trst   CODE Pop_Age M_Pop_Age F_Pop_Age X._Pvt_HHld
1       0.01294118   0.06588235 N2L2J2    85.0      86.1      83.5         5.0
2       0.02181818   0.09272727 L9M1Z4    37.5      35.0      67.5         2.0
3       0.02250000   0.13250000 N7G3J7    85.0      37.5      87.4         3.0
4       0.03093750   0.11531250 M9A5E4    86.6      33.2      88.6        13.0
5       0.02250000   0.07950000 M1N1M9    79.5      68.6      81.9         5.3
6       0.04342105   0.15052632 M1N4E6    68.9      65.0      70.0         3.0
  X._Fam_Hhld X._NF_Hhld Avg_Chld_PrCen_Fm_Hhld     Houses        Apt
1           1          0                    1.0 0.02941176 0.00000000
2           1          0                    1.0 0.09090909 0.00000000
3           1          0                    1.0 0.12500000 0.00000000
4           1          0                    0.0 0.00000000 0.03125000
5           2          1                    2.0 0.03750000 0.00000000
6          14          6                    1.4 0.07894737 0.05263158
      Condos Hhld.Income High.School Clg_CEGEP_Non_Uni_Dip Uni_Dip_Blw_Bach
1 0.00000000   1528.1129  0.02941176            0.02941176       0.02941176
2 0.00000000  28276.7809  0.09090909            0.00000000       0.09090909
3 0.00000000  10098.6787  0.12500000            0.00000000       0.00000000
4 0.03125000   2608.7778  0.09375000            0.06250000       0.12500000
5 0.01250000    359.3750  0.05000000            0.03750000       0.06250000
6 0.03289474    318.8611  0.07894737            0.07894737       0.11184210
        Empl       UnEmp    Tot_Mig
1 0.08823529 0.029411765 0.02941176
2 0.18181818 0.000000000 0.00000000
3 0.25000000 0.000000000 0.00000000
4 0.09375000 0.031250000 0.21875000
5 0.11250000 0.000000000 0.11250000
6 0.11184210 0.006578947 0.22368421

[75869 rows x 34 columns] 

6.7.1 Confusion Matrices for RF

Training sample

While this might be interesting, it is best not to place too much credence on the hit-ratio for the training sample since this sample is used to build the model.

h2o.confusionMatrix(fs4C.class_rf,  fs.split[[1]]   )   

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error          Rate
Seg1   29081     1     0     3 0.0001 =  4 / 29,085
Seg2       0 53576     0     3 0.0001 =  3 / 53,579
Seg3       0     0 43924     0 0.0000 =  0 / 43,924
Seg4       1     1     0 50267 0.0000 =  2 / 50,269
Totals 29082 53578 43924 50273 0.0001 = 9 / 176,857

Testing Sample

Successful prediction is clearly showcased for segments as seen in the confusion matrix below. Using the RF model, 3,895 out of 75,891 people were incorrectly assigned to their segment membership, resulting in an error rate of 5.13%, which is very good. This means that the hit ratio was roughly 94.87%, which is very credible.

h2o.confusionMatrix(fs4C.class_rf,  fs.split[[2]]   )   

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error             Rate
Seg1   11475   404   291   314 0.0808 = 1,009 / 12,484
Seg2     326 22043   103   723 0.0497 = 1,152 / 23,195
Seg3     225    54 18118   274 0.0296 =   553 / 18,671
Seg4     200   642   450 20227 0.0600 = 1,292 / 21,519
Totals 12226 23143 18962 21538 0.0528 = 4,006 / 75,869

6.7.2 Hit Ratios for RF

As briefly mentioned above, the hit ratio is roughly 94.87%, which is fantastic. This alone is not enough to deduce that the model is good, therefore below we have created a recepticle of metrics to explore futher for all the models.

h2o.hit_ratio_table(fs4C.class_rf, train=TRUE, valid=TRUE)   

$train
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.935959
2 2  0.992796
3 3  0.997614
4 4  1.000000

$valid
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.947198
2 2  0.995703
3 3  0.999407
4 4  1.000000

6.7.3 Creating an object to hold important diagnostic information

A receptacle for diagnostic statistics is created below so that this information can be compared efficiently at the end of the predictive modeling. We will be comparing the hit ratios, MSEs, RMSEs, loglosses, and mean-per-class-errors.

modH <- data.frame(Prediction_model=character(),
                  hit_ratio=numeric(),
                  MSE=numeric(),
                  RMSE=numeric(),
                  logloss=numeric(),
                  mean_per_class_error=numeric(),
                  stringsAsFactors=FALSE) 

modH[1, 1] <- "Random_forest"
modH[1, 2] <- fs4C.class_rf@model$validation_metrics@metrics$hit_ratio_table$hit_ratio[1] #  
modH[1, 3] <- fs4C.class_rf@model$validation_metrics@metrics$MSE   #  
modH[1, 4] <- fs4C.class_rf@model$validation_metrics@metrics$RMSE       #  
modH[1, 5] <- fs4C.class_rf@model$validation_metrics@metrics$ logloss
modH[1, 6] <- fs4C.class_rf@model$validation_metrics@metrics$ mean_per_class_error  

6.7.4 Plotting variable importances

Here we are predicting importance of variables using plotly package available in H2O function. We can see that the top five variables with the highest relative importances are:

1. Dollar value of annual premiums for home insurance (by a long shot)
2. Number of people who own smart thermostats
3. Number of people having trust in financial/banking app
4. Number of people who purchased smart phones
5. Number of people who plan on purchasing smart home technology

rf_variable_importances <- as.data.frame(fs4C.class_rf@model$variable_importances)
# rf_variable_importances
#install.packages("plotly", dependencies=TRUE)
library(plotly)
plot_ly(rf_variable_importances, 
        #        x = rf_variable_importances$percentage, 
        y=reorder(rf_variable_importances$variable,
                  rf_variable_importances$percentage),
        x = rf_variable_importances$percentage,
        color = rf_variable_importances$variable,
        type = 'bar', orientation = 'h') %>%
  layout( title = "Variable Importance for the random forest model",
          xaxis = list(title = "Percentage Importance"),
          ylim=c(0,1),
          margin = list(l = 120))  

6.8.1 Confusion Matrices for GLM

Training sample

Similarly to what we did for random forest, here we are checking confusion matrix for all segments within the training sample.

# str(fs8C.class_glm)
fs4C.class_glm@ model$ training_metrics@ metrics$ cm$ table

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error            Rate
Seg1   29038    22     4    21 0.0016 =   47 / 29,085
Seg2      15 53532     1    31 0.0009 =   47 / 53,579
Seg3      22     2 43875    25 0.0011 =   49 / 43,924
Seg4       6    25    20 50218 0.0010 =   51 / 50,269
Totals 29081 53581 43900 50295 0.0011 = 194 / 176,857

# h2o.confusionMatrix( fs4C.class_glm, train = TRUE)

Testing sample

Successful prediction is clearly showcased for segments as seen in the confusion matrix below. Using the GLM model, 102 out of 75,891 people were incorrectly assigned to their segment membership, resulting in an error rate of 0.13%, which is even better than random forest good. This means that the hit ratio was roughly 99.87%, which is even more credible than random forest.

# str(fs4C.class_glm)
fs4C.class_glm@ model$ validation_metrics@ metrics$ cm$ table 

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error           Rate
Seg1   12450    16     1    17 0.0027 =  34 / 12,484
Seg2       8 23162     1    24 0.0014 =  33 / 23,195
Seg3       7     0 18654    10 0.0009 =  17 / 18,671
Seg4       5    15    11 21488 0.0014 =  31 / 21,519
Totals 12470 23193 18667 21539 0.0015 = 115 / 75,869

# h2o.confusionMatrix(fs4C.class_glm, valid = TRUE) # another way to see confusion matrix

6.8.2 Plotting variable importance

Looking at the variable importances, we can see that the top five variables in terms of them having the highest relative importance are:

1. Dollar value of annual premiums for home insurance (by a long shot)
2. Number of people who own smart thermostats
3. Number of people who purchased smart phones
4. Number of people having trust in financial/banking app
5. Number of people who plan on purchasing smart home technology

h2o.varimp(fs4C.class_glm)

            variable relative_importance scaled_importance percentage
1   Ann_Prem_Hm_Insu           46.408944        1.00000000 0.19169294
2        X.Smt_Therm           33.312419        0.71780169 0.13759752
3     X..Smart_purch           23.821684        0.51329943 0.09839588
4       Fin_App_Trst           23.526912        0.50694780 0.09717832
5        Tech.Enthu.           20.993106        0.45235043 0.08671239
6       X.Smt_Hm_Ass           17.327060        0.37335604 0.07156972
7         Confidence           15.051687        0.32432729 0.06217125
8   X.Smt_Hm_Sec.Pln           11.359219        0.24476356 0.04691945
9         Smt_Hm_Dev           11.028004        0.23762669 0.04555136
10     X.Smt_Hm_Secu           10.383195        0.22373263 0.04288797
11  X.Smt_Hm_Dev.Pln            7.100212        0.15299231 0.02932755
12  Mob_Inf_sec_cons            7.016669        0.15119217 0.02898247
13  X.Smat_Therm.Pln            5.232745        0.11275295 0.02161394
14 X.Smt_Hm_Asst.Pln            4.952652        0.10671763 0.02045702
15     Mob_Mark_cons            4.585922        0.09881548 0.01894223

#glm_variable_importances <- as.data.frame(fs4C.class_glm@model$variable_importances)
glm_variable_importances <- as.data.frame(h2o.varimp(fs4C.class_glm))
## rf_variable_importances
##install.packages("plotly", dependencies=TRUE)
pacman::p_load(plotly)
plot_ly(glm_variable_importances,
        #        x = rf_variable_importances$percentage,
        y=reorder(glm_variable_importances$variable,
                 glm_variable_importances$percentage),
        x = glm_variable_importances$percentage,
        color = glm_variable_importances$variable,
        type = 'bar', orientation = 'h') %>%
  layout( title = "Variable Importance for the logistic regression model on 4 segments",
          xaxis = list(title = "Percentage Importance"),
          ylim=c(0,1),
          margin = list(l = 120))

modH[2, 1] <- "GLM_log_regr"
modH[2, 2] <- fs4C.class_glm@model$validation_metrics@metrics$hit_ratio_table$hit_ratio[1] #  
modH[2, 3] <- fs4C.class_glm@model$validation_metrics@metrics$MSE   #  
modH[2, 4] <- fs4C.class_glm@model$validation_metrics@metrics$RMSE       #  
modH[2, 5] <- fs4C.class_glm@model$validation_metrics@metrics$ logloss
modH[2, 6] <- fs4C.class_glm@model$validation_metrics@metrics$ mean_per_class_error 

6.9.1 Model Performance

perf <- h2o.performance(fs4C.class_gbm, fs.split[[2]])
perf

H2OMultinomialMetrics: gbm

Test Set Metrics: 
=====================

MSE: (Extract with `h2o.mse`) 0.05102248
RMSE: (Extract with `h2o.rmse`) 0.2258816
Logloss: (Extract with `h2o.logloss`) 0.1765651
Mean Per-Class Error: 0.05254961
R^2: (Extract with `h2o.r2`) 0.954615
Confusion Matrix: Extract with `h2o.confusionMatrix(<model>, <data>)`)
=========================================================================
Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error             Rate
Seg1   11603   335   233   313 0.0706 =   881 / 12,484
Seg2     243 22154    66   732 0.0449 = 1,041 / 23,195
Seg3     347    99 17931   294 0.0396 =   740 / 18,671
Seg4     178   595   413 20333 0.0551 = 1,186 / 21,519
Totals 12371 23183 18643 21672 0.0507 = 3,848 / 75,869

Hit Ratio Table: Extract with `h2o.hit_ratio_table(<model>, <data>)`
=======================================================================
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.949281
2 2  0.995611
3 3  0.999697
4 4  1.000000

6.9.2 Confusion Matrices

# str(fs4C.class_glm)
fs4C.class_gbm@ model$ training_metrics@ metrics$ cm$ table

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error              Rate
Seg1   27376   630   430   649 0.0588 =  1,709 / 29,085
Seg2     453 51684   101  1341 0.0354 =  1,895 / 53,579
Seg3     587   167 42569   601 0.0308 =  1,355 / 43,924
Seg4     312  1114   863 47980 0.0455 =  2,289 / 50,269
Totals 28728 53595 43963 50571 0.0410 = 7,248 / 176,857

# h2o.confusionMatrix( fs4C.class_glm,train = TRUE)

Testing Sample

The confusion matrix for the testing sample is as below

h2o.confusionMatrix(fs4C.class_gbm, fs.split[[2]]) # CONFUSION TABLE FOR HOLDOUT

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error             Rate
Seg1   11603   335   233   313 0.0706 =   881 / 12,484
Seg2     243 22154    66   732 0.0449 = 1,041 / 23,195
Seg3     347    99 17931   294 0.0396 =   740 / 18,671
Seg4     178   595   413 20333 0.0551 = 1,186 / 21,519
Totals 12371 23183 18643 21672 0.0507 = 3,848 / 75,869

h2o.confusionMatrix(perf) # DIFFERENT WAY

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error             Rate
Seg1   11603   335   233   313 0.0706 =   881 / 12,484
Seg2     243 22154    66   732 0.0449 = 1,041 / 23,195
Seg3     347    99 17931   294 0.0396 =   740 / 18,671
Seg4     178   595   413 20333 0.0551 = 1,186 / 21,519
Totals 12371 23183 18643 21672 0.0507 = 3,848 / 75,869

Training Sample

Using the GBM model, 3,714 out of 75,891 people were incorrectly assigned to their segment membership, resulting in an error rate of 4.89%, which is better than that of the Random Forest Model, but not as low as the GLM Model. This means that the hit ratio was roughly 95.10%, which is still a great hit ratio. All the models seem to have great hit ratios (all are 94% or above).

# str(fs6C.class_gbm)
# fs6C.class_glm@ model$ validation_metrics@ metrics$ cm$ table
h2o.confusionMatrix(fs4C.class_gbm,valid = TRUE)

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error             Rate
Seg1   11603   335   233   313 0.0706 =   881 / 12,484
Seg2     243 22154    66   732 0.0449 = 1,041 / 23,195
Seg3     347    99 17931   294 0.0396 =   740 / 18,671
Seg4     178   595   413 20333 0.0551 = 1,186 / 21,519
Totals 12371 23183 18643 21672 0.0507 = 3,848 / 75,869

6.9.3 Plotting variable importance

h2o.varimp(fs4C.class_gbm)

Variable Importances: 
            variable relative_importance scaled_importance percentage
1        X.Smt_Therm       107209.156250          1.000000   0.214047
2   Ann_Prem_Hm_Insu       102356.835938          0.954740   0.204359
3       Fin_App_Trst        70859.429688          0.660946   0.141474
4     X..Smart_purch        61462.792969          0.573298   0.122713
5   X.Smt_Hm_Sec.Pln        33581.839844          0.313237   0.067047
6        Tech.Enthu.        29895.560547          0.278853   0.059688
7       X.Smt_Hm_Ass        24125.326172          0.225030   0.048167
8      X.Smt_Hm_Secu        20156.285156          0.188009   0.040243
9         Smt_Hm_Dev        15659.624023          0.146066   0.031265
10        Confidence        14745.135742          0.137536   0.029439
11  Mob_Inf_sec_cons         8862.408203          0.082665   0.017694
12  X.Smt_Hm_Dev.Pln         8198.396484          0.076471   0.016368
13  X.Smat_Therm.Pln         1741.412231          0.016243   0.003477
14 X.Smt_Hm_Asst.Pln         1040.876465          0.009709   0.002078
15     Mob_Mark_cons          971.792908          0.009064   0.001940

Looking at the variable importances, we can see that the top five variables in terms of them having the highest relative importance are:

1. Number of people who own smart thermostats
2. Dollar value of annual premiums for home insurance
3. Number of people who trust in financial banking applications
4. Number of people who purchased smart phones
5. Number of people planning to purchase smart home security technology

# glm_variable_importances <- as.data.frame(fs6C.class_glm@model$variable_importances)
gbm_variable_importances <- as.data.frame(h2o.varimp(fs4C.class_gbm))
# rf_variable_importances
#install.packages("plotly", dependencies=TRUE)
pacman::p_load(plotly)
plot_ly(gbm_variable_importances,
        #        x = rf_variable_importances$percentage,
        y=reorder(gbm_variable_importances$variable,
                  gbm_variable_importances$percentage),
        x = gbm_variable_importances$percentage,
        color = gbm_variable_importances$variable,
        type = 'bar', orientation = 'h') %>%
  layout( title = "Variable Importance for GBM model of 4-segment solution",
          xaxis = list(title = "Percentage Importance"),
          ylim=c(0,1),
          margin = list(l = 120))

6.11.1 Variable Exploration

fs2<-as.data.frame(fs4C.class)

The following bar charts simply show the number of people or number of households in each category.

library(ggplot2)
ggplot(data.frame(fs2), aes(x=Pop_Age)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=M_Pop_Age)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=F_Pop_Age)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Pvt_HHld)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Fam_Hhld)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=NF_Hhld)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Avg_Chld_PrCen_Fm_Hhld)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Houses)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Apt)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Condos)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Hhld.Income)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=High.School)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Clg_CEGEP_Non_Uni_Dip)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Uni_Dip_Blw_Bach)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Empl)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=UnEmp)) +
  geom_bar()

ggplot(data.frame(fs2), aes(x=Tot_Mig)) +
  geom_bar()

6.11.2 Splitting the sample for cross-validation

We will start with splitting our dataset into training and testing set.

#__splitting df into training (70%) and testing (validation) datasets________
fs.split<- h2o.splitFrame(fs4C.class, ratios=c(0.7))

The training sample on which the predictive model will be built is below.

fs.split[[1]]

   Confidence predict Tech.Enthu. Ann_Prem_Hm_Insu Mob_Mark_cons
1 0.009426962    Seg2 0.009739573      0.004403856   0.005647059
2 0.025949382    Seg2 0.014750739      0.005865521   0.012673267
3 0.025238024    Seg2 0.029873820      0.020744546   0.015555556
4 0.031883370    Seg2 0.024817610      0.018098652   0.011764706
5 0.056125319    Seg2 0.061331941      0.063795120   0.030182927
6 0.030407734    Seg2 0.031585243      0.020467166   0.011842105
  Mob_Inf_sec_cons X..Smart_purch X.Smt_Therm X.Smt_Hm_Secu X.Smt_Hm_Ass
1      0.007529412    0.007152941 0.009788235   0.004517647   0.01204706
2      0.021386139    0.014257426 0.022178218   0.007128713   0.02534653
3      0.025555556    0.018888889 0.028888889   0.012222222   0.03222222
4      0.027058824    0.021176471 0.028235294   0.009411765   0.03529412
5      0.028170732    0.024146341 0.042256098   0.012073171   0.03823171
6      0.030263158    0.015789474 0.034210526   0.019736842   0.04473684
   Smt_Hm_Dev X.Smat_Therm.Pln X.Smt_Hm_Sec.Pln X.Smt_Hm_Asst.Pln
1 0.007152941      0.004517647      0.007905882       0.002635294
2 0.011881188      0.011089109      0.012673267       0.005544554
3 0.018888889      0.011111111      0.018888889       0.011111111
4 0.020000000      0.016470588      0.014117647       0.015294118
5 0.024146341      0.032195122      0.028170732       0.034207317
6 0.025000000      0.010526316      0.019736842       0.009210526
  X.Smt_Hm_Dev.Pln Fin_App_Trst   CODE            Pop_Age          M_Pop_Age
1      0.004141176   0.01882353 K7L5R2        26-50 Years        26-50 Years
2      0.011089109   0.04514852 K9V6H4        26-50 Years        26-50 Years
3      0.008888889   0.05666667 N2L2G4 More than 76 Years More than 76 Years
4      0.012941176   0.06588235 N2L2J2 More than 76 Years More than 76 Years
5      0.030182927   0.09054878 N7L5H5 More than 76 Years        51-75 Years
6      0.018421053   0.07236842 N3L4E3        51-75 Years        51-75 Years
           F_Pop_Age                       Pvt_HHld              Fam_Hhld
1         0-25 Years 5-6 Persons Private Households 0-5 Family Households
2        26-50 Years  8+ Persons Private Households 0-5 Family Households
3 More than 76 Years 7-8 Persons Private Households 0-5 Family Households
4 More than 76 Years 5-6 Persons Private Households 0-5 Family Households
5 More than 76 Years 3-4 Persons Private Households 0-5 Family Households
6        51-75 Years 7-8 Persons Private Households 0-5 Family Households
                    NF_Hhld     Avg_Chld_PrCen_Fm_Hhld                 Houses
1 0-1 Non-Family Households   3 Children Per Household 0-25% Living in Houses
2 0-1 Non-Family Households   3 Children Per Household 0-25% Living in Houses
3 0-1 Non-Family Households   2 Children Per Household 0-25% Living in Houses
4 0-1 Non-Family Households 0-1 Children Per Household 0-25% Living in Houses
5  9+ Non-Family Households   3 Children Per Household 0-25% Living in Houses
6 0-1 Non-Family Households 0-1 Children Per Household 0-25% Living in Houses
                         Apt                 Condos
1 0-25% Living in Apartments 0-25% Living in Condos
2 0-25% Living in Apartments 0-25% Living in Condos
3 0-25% Living in Apartments 0-25% Living in Condos
4 0-25% Living in Apartments 0-25% Living in Condos
5 0-25% Living in Apartments 0-25% Living in Condos
6 0-25% Living in Apartments 0-25% Living in Condos
                     Hhld.Income                 High.School
1 Household income $0 to $19,999 0-25% completed High School
2 Household income $0 to $19,999 0-25% completed High School
3 Household income $0 to $19,999 0-25% completed High School
4 Household income $0 to $19,999 0-25% completed High School
5 Household income $0 to $19,999 0-25% completed High School
6 Household income $0 to $19,999 0-25% completed High School
                   Clg_CEGEP_Non_Uni_Dip                  Uni_Dip_Blw_Bach
1 0-25% completed Non-University Diploma 0-25% completed University Degree
2 0-25% completed Non-University Diploma 0-25% completed University Degree
3 0-25% completed Non-University Diploma 0-25% completed University Degree
4 0-25% completed Non-University Diploma 0-25% completed University Degree
5 0-25% completed Non-University Diploma 0-25% completed University Degree
6 0-25% completed Non-University Diploma 0-25% completed University Degree
            Empl            UnEmp           Tot_Mig
1 0-25% Employed 0-25% Unemployed  0-25% Immigrants
2 0-25% Employed 0-25% Unemployed  0-25% Immigrants
3 0-25% Employed 0-25% Unemployed  0-25% Immigrants
4 0-25% Employed 0-25% Unemployed  0-25% Immigrants
5 0-25% Employed 0-25% Unemployed 26-50% Immigrants
6 0-25% Employed 0-25% Unemployed  0-25% Immigrants

[176995 rows x 34 columns] 

The holdout, or testing, sample will be used to help understand the ability of the model to predict segment membership.

fs.split[[2]]

  Confidence predict Tech.Enthu. Ann_Prem_Hm_Insu Mob_Mark_cons
1 0.03043390    Seg2  0.02847967      0.009048419    0.01876543
2 0.07610093    Seg2  0.03983030      0.092729259    0.02285714
3 0.17222783    Seg2  0.09188291      0.191906973    0.04990826
4 0.08864146    Seg2  0.09336437      0.015857921    0.03712871
5 0.07195438    Seg2  0.07085803      0.070776382    0.04000000
6 0.06057126    Seg2  0.07169717      0.074680364    0.03733333
  Mob_Inf_sec_cons X..Smart_purch X.Smt_Therm X.Smt_Hm_Secu X.Smt_Hm_Ass
1       0.02765432     0.02469136  0.02370370   0.011851852   0.02666667
2       0.02857143     0.01285714  0.01857143   0.005714286   0.02000000
3       0.04366972     0.05614679  0.03119266   0.006238532   0.04990826
4       0.04455445     0.06930693  0.06188119   0.032178218   0.06188119
5       0.04500000     0.04750000  0.05000000   0.020000000   0.06000000
6       0.04666667     0.03033333  0.05366667   0.018666667   0.04200000
  Smt_Hm_Dev X.Smat_Therm.Pln X.Smt_Hm_Sec.Pln X.Smt_Hm_Asst.Pln
1 0.01876543       0.01777778       0.02172840        0.01283951
2 0.01285714       0.01142857       0.01142857        0.01285714
3 0.03119266       0.01871560       0.03119266        0.04990826
4 0.04702970       0.03465347       0.05693069        0.02722772
5 0.04500000       0.03750000       0.04500000        0.02500000
6 0.02566667       0.03733333       0.03966667        0.02566667
  X.Smt_Hm_Dev.Pln Fin_App_Trst   CODE            Pop_Age          M_Pop_Age
1       0.01580247   0.05827160 M6B2P9 More than 76 Years More than 76 Years
2       0.01000000   0.07571429 K6H6X7 More than 76 Years More than 76 Years
3       0.03743119   0.24330275 L4A0P5        51-75 Years        51-75 Years
4       0.03217822   0.13613861 M6B4E5 More than 76 Years        51-75 Years
5       0.04000000   0.13500000 L9M2B9        26-50 Years        26-50 Years
6       0.02333333   0.10266667 L9C2C7 More than 76 Years        51-75 Years
           F_Pop_Age                       Pvt_HHld                Fam_Hhld
1 More than 76 Years  8+ Persons Private Households   0-5 Family Households
2 More than 76 Years 0-2 Persons Private Households   0-5 Family Households
3        51-75 Years 0-2 Persons Private Households 21-25 Family Households
4 More than 76 Years  8+ Persons Private Households   0-5 Family Households
5        26-50 Years 3-4 Persons Private Households   0-5 Family Households
6 More than 76 Years 3-4 Persons Private Households   0-5 Family Households
                    NF_Hhld     Avg_Chld_PrCen_Fm_Hhld                 Houses
1 0-1 Non-Family Households   3 Children Per Household 0-25% Living in Houses
2 0-1 Non-Family Households 0-1 Children Per Household 0-25% Living in Houses
3  9+ Non-Family Households 0-1 Children Per Household 0-25% Living in Houses
4 0-1 Non-Family Households 0-1 Children Per Household 0-25% Living in Houses
5 0-1 Non-Family Households 0-1 Children Per Household 0-25% Living in Houses
6 0-1 Non-Family Households   2 Children Per Household 0-25% Living in Houses
                                 Apt                 Condos
1         0-25% Living in Apartments 0-25% Living in Condos
2         0-25% Living in Apartments 0-25% Living in Condos
3 26-50% Years  Living in Apartments 0-25% Living in Condos
4         0-25% Living in Apartments 0-25% Living in Condos
5         0-25% Living in Apartments 0-25% Living in Condos
6         0-25% Living in Apartments 0-25% Living in Condos
                     Hhld.Income                 High.School
1 Household income $0 to $19,999 0-25% completed High School
2 Household income $0 to $19,999 0-25% completed High School
3 Household income $0 to $19,999 0-25% completed High School
4 Household income $0 to $19,999 0-25% completed High School
5 Household income $0 to $19,999 0-25% completed High School
6 Household income $0 to $19,999 0-25% completed High School
                   Clg_CEGEP_Non_Uni_Dip                  Uni_Dip_Blw_Bach
1 0-25% completed Non-University Diploma 0-25% completed University Degree
2 0-25% completed Non-University Diploma 0-25% completed University Degree
3 0-25% completed Non-University Diploma 0-25% completed University Degree
4 0-25% completed Non-University Diploma 0-25% completed University Degree
5 0-25% completed Non-University Diploma 0-25% completed University Degree
6 0-25% completed Non-University Diploma 0-25% completed University Degree
            Empl            UnEmp          Tot_Mig
1 0-25% Employed 0-25% Unemployed 0-25% Immigrants
2 0-25% Employed 0-25% Unemployed 0-25% Immigrants
3 0-25% Employed 0-25% Unemployed 0-25% Immigrants
4 0-25% Employed 0-25% Unemployed 0-25% Immigrants
5 0-25% Employed 0-25% Unemployed 0-25% Immigrants
6 0-25% Employed 0-25% Unemployed 0-25% Immigrants

[75731 rows x 34 columns] 

6.12.1 Confusion Matrices

Training Sample The predictive ability of the random forest model on the training sample is quite poor. However, this information should not be relied upon.

h2o.confusionMatrix(fs3Cov.class_rf,  fs.split[[1]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error               Rate
Seg1   15287  5765  4458  3507 0.4732 =  13,730 / 29,017
Seg2    2542 36994  3719 10581 0.3128 =  16,842 / 53,836
Seg3    1524  2585 36299  3460 0.1725 =   7,569 / 43,868
Seg4    1653 11066  4100 33455 0.3345 =  16,819 / 50,274
Totals 21006 56410 48576 51003 0.3105 = 54,960 / 176,995

Testing Sample

The error rate and the corresponding hit-ratio for the testing sample are very poor compared to level one segmentation using random forest. 27,395 out of 75,754 people were incorrectly assigned their segment membership, resulting in an error rate of 36.16% or a hit ratio of 63.84%.

h2o.confusionMatrix(fs3Cov.class_rf,  fs.split[[2]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
       Seg1  Seg2  Seg3  Seg4  Error              Rate
Seg1   5636  2861  2244  1811 0.5510 =  6,916 / 12,552
Seg2   1453 14567  1832  5086 0.3649 =  8,371 / 22,938
Seg3    859  1261 14797  1810 0.2099 =  3,930 / 18,727
Seg4    922  5349  2071 13172 0.3877 =  8,342 / 21,514
Totals 8870 24038 20944 21879 0.3639 = 27,559 / 75,731

As mentioned above, the hit ratio for the training sample is 63.84%.

h2o.hit_ratio_table(fs3Cov.class_rf, train=TRUE, valid=TRUE )

$train
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.636606
2 2  0.878381
3 3  0.968664
4 4  1.000000

$valid
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.636094
2 2  0.878768
3 3  0.970171
4 4  1.000000

6.12.2 Variable Importances

While total immigrants, houses, university diploma education, average child per household, # of private households are the most important variables, they are not doing a very good job of predicting segment membership.

fs3Cov.class_rf@model$variable_importances

Variable Importances: 
                 variable relative_importance scaled_importance percentage
1                 Tot_Mig       212571.953125          1.000000   0.242930
2                  Houses        93486.242188          0.439786   0.106837
3        Uni_Dip_Blw_Bach        82943.546875          0.390190   0.094789
4  Avg_Chld_PrCen_Fm_Hhld        71780.531250          0.337676   0.082032
5                Pvt_HHld        66663.859375          0.313606   0.076184
6                 NF_Hhld        62827.562500          0.295559   0.071800
7                Fam_Hhld        54388.355469          0.255859   0.062156
8                    Empl        46267.671875          0.217657   0.052875
9                     Apt        44258.714844          0.208206   0.050579
10                Pop_Age        30073.251953          0.141473   0.034368
11              F_Pop_Age        25027.115234          0.117735   0.028601
12              M_Pop_Age        23832.818359          0.112116   0.027236
13            Hhld.Income        20380.693359          0.095877   0.023291
14            High.School        15530.393555          0.073059   0.017748
15  Clg_CEGEP_Non_Uni_Dip        12773.874023          0.060092   0.014598
16                 Condos        10440.803711          0.049117   0.011932
17                  UnEmp         1786.749756          0.008405   0.002042

6.12.3 The diagnostic statistics

The table below shows the hit-ratio, MSE (mean square error), RMSE (root mean square error), logloss and mean-per-class-error for the random forest model. This will be compared to the other models further along in this document.

# THE FOLLOWING covH data frame IS TO HOLD STATISTICS FROM EACH MODEL
covH <- data.frame(Prediction_model=character(),
                   hit_ratio=numeric(),
                   MSE=numeric(),
                   RMSE=numeric(),
                   logloss=numeric(),
                   mean_per_class_error=numeric(),
                   stringsAsFactors=FALSE)

covH[1, 1] <- "Random_forest"
covH[1, 2] <- fs3Cov.class_rf@model$validation_metrics@metrics$hit_ratio_table$hit_ratio[1] #  
covH[1, 3] <- fs3Cov.class_rf@model$validation_metrics@metrics$MSE   #  
covH[1, 4] <- fs3Cov.class_rf@model$validation_metrics@metrics$RMSE       #  
covH[1, 5] <- fs3Cov.class_rf@model$validation_metrics@metrics$ logloss
covH[1, 6] <- fs3Cov.class_rf@model$validation_metrics@metrics$ mean_per_class_error
covH

  Prediction_model hit_ratio       MSE     RMSE   logloss mean_per_class_error
1    Random_forest 0.6360936 0.2957424 0.543822 0.8446302            0.3783833

6.13.1 Confusion Matrices

Training Sample

The error rate is quite poor on the training sample for the random forest model, roughly 37%.

h2o.confusionMatrix(fs3Cov.class_glm,  fs.split[[1]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error               Rate
Seg1   12908  7228  4835  4046 0.5552 =  16,109 / 29,017
Seg2    3820 33332  4145 12539 0.3809 =  20,504 / 53,836
Seg3    2244  3721 33868  4035 0.2280 =  10,000 / 43,868
Seg4    2403 12503  4536 30832 0.3867 =  19,442 / 50,274
Totals 21375 56784 47384 51452 0.3732 = 66,055 / 176,995

Testing Sample

The holdout sample error rate is almost as worse as that of the training sample. It is 37.19% for the training sample.

h2o.confusionMatrix(fs3Cov.class_glm,  fs.split[[2]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
       Seg1  Seg2  Seg3  Seg4  Error              Rate
Seg1   5543  3146  2111  1752 0.5584 =  7,009 / 12,552
Seg2   1675 14121  1784  5358 0.3844 =  8,817 / 22,938
Seg3    908  1525 14483  1811 0.2266 =  4,244 / 18,727
Seg4    966  5407  1972 13169 0.3879 =  8,345 / 21,514
Totals 9092 24199 20350 22090 0.3752 = 28,415 / 75,731

Of course the hit-ratios, which are just 1 minus the error rates, are quite poor. 62.81% for the training sample.

h2o.hit_ratio_table(fs3Cov.class_glm, train=TRUE, valid=TRUE )

$train
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.626797
2 2  0.872663
3 3  0.967745
4 4  1.000000

$valid
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.624790
2 2  0.870581
3 3  0.967266
4 4  1.000000

6.13.2 Diagnostic statistics for the GLM model

The table below shows that the diagnostic statistics for the random forest model and logistic regression model. So far, the Random Forest model looks overall better, but not good enough to present to a client.

covH[2, 1] <- "GLM"
covH[2, 2] <- fs3Cov.class_glm@model$validation_metrics@metrics$hit_ratio_table$hit_ratio[1] #  
covH[2, 3] <- fs3Cov.class_glm@model$validation_metrics@metrics$MSE   #  
covH[2, 4] <- fs3Cov.class_glm@model$validation_metrics@metrics$RMSE       #  
covH[2, 5] <- fs3Cov.class_glm@model$validation_metrics@metrics$ logloss
covH[2, 6] <- fs3Cov.class_glm@model$validation_metrics@metrics$ mean_per_class_error
covH

  Prediction_model hit_ratio       MSE     RMSE   logloss mean_per_class_error
1    Random_forest 0.6360936 0.2957424 0.543822 0.8446302            0.3783833
2              GLM 0.6247904 0.3068551 0.553945 0.8733787            0.3893232

6.14.1 Confusion Matrices

Training Sample

The training sample error rate is 36.67% however, this does not really mean anything as we care more about the testing sample.

fs3Cov.class_dl@model$training_metrics  

H2OMultinomialMetrics: deeplearning
** Reported on training data. **
** Metrics reported on temporary training frame with 9912 samples **

Training Set Metrics: 
=====================

MSE: (Extract with `h2o.mse`) 0.2885144
RMSE: (Extract with `h2o.rmse`) 0.5371354
Logloss: (Extract with `h2o.logloss`) 0.8378529
Mean Per-Class Error: 0.3821669
Confusion Matrix: Extract with `h2o.confusionMatrix(<model>,train = TRUE)`)
=========================================================================
Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
       Seg1 Seg2 Seg3 Seg4  Error            Rate
Seg1    650  239  385  327 0.5940 =   951 / 1,601
Seg2    200 1556  328  926 0.4831 = 1,454 / 3,010
Seg3     55   61 2091  279 0.1589 =   395 / 2,486
Seg4     74  464  286 1991 0.2927 =   824 / 2,815
Totals  979 2320 3090 3523 0.3656 = 3,624 / 9,912

Hit Ratio Table: Extract with `h2o.hit_ratio_table(<model>,train = TRUE)`
=======================================================================
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.634383
2 2  0.877018
3 3  0.970742
4 4  1.000000

Testing Sample

Unfortunately, the validation sample error rate is in the same ball park as the other models for level 2 segmentation, at roughly 37.65%.

h2o.confusionMatrix(fs3Cov.class_dl,  fs.split[[2]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
       Seg1  Seg2  Seg3  Seg4  Error              Rate
Seg1   4929  1965  3173  2485 0.6073 =  7,623 / 12,552
Seg2   1309 11545  2837  7247 0.4967 = 11,393 / 22,938
Seg3    402   477 15763  2085 0.1583 =  2,964 / 18,727
Seg4    612  3581  2322 14999 0.3028 =  6,515 / 21,514
Totals 7252 17568 24095 26816 0.3763 = 28,495 / 75,731

Again, the hit ratios are very poor. The training sample hit ratio is 62.35%.

h2o.hit_ratio_table(fs3Cov.class_dl, train=TRUE, valid=TRUE )

$train
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.634383
2 2  0.877018
3 3  0.970742
4 4  1.000000

$valid
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.623734
2 2  0.873011
3 3  0.969035
4 4  1.000000

6.14.2 Diagnostic statistics

The diagnostics statistics table indicates that the Random Forest model is still the best performer in a very dismal race.

covH[3, 1] <- "Deep_Learning"
covH[3, 2] <- fs3Cov.class_dl@model$validation_metrics@metrics$hit_ratio_table$hit_ratio[1] #  
covH[3, 3] <- fs3Cov.class_dl@model$validation_metrics@metrics$MSE   #  
covH[3, 4] <- fs3Cov.class_dl@model$validation_metrics@metrics$RMSE       #  
covH[3, 5] <- fs3Cov.class_dl@model$validation_metrics@metrics$ logloss
covH[3, 6] <- fs3Cov.class_dl@model$validation_metrics@metrics$ mean_per_class_error
covH

  Prediction_model hit_ratio       MSE      RMSE   logloss mean_per_class_error
1    Random_forest 0.6360936 0.2957424 0.5438220 0.8446302            0.3783833
2              GLM 0.6247904 0.3068551 0.5539450 0.8733787            0.3893232
3    Deep_Learning 0.6237340 0.2963624 0.5443918 0.8637924            0.3912751

6.15.1 Confusion Matrices

Training Sample

The high error rate shown below for the training sample is similar to that of the previous models, hovering in the 35.97% range.

h2o.confusionMatrix(fs3Cov.class_gbm,  fs.split[[1]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error               Rate
Seg1   13353  6628  4933  4103 0.5398 =  15,664 / 29,017
Seg2    3384 34681  4168 11603 0.3558 =  19,155 / 53,836
Seg3    2017  3145 34653  4053 0.2101 =   9,215 / 43,868
Seg4    2237 12725  4421 30891 0.3855 =  19,383 / 50,274
Totals 20991 57179 48175 50650 0.3583 = 63,417 / 176,995

Testing Sample

However, the holdout sample error rate is 36.17%, which is again in the same ball park as the previous models.

h2o.confusionMatrix(fs3Cov.class_gbm,  fs.split[[2]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
       Seg1  Seg2  Seg3  Seg4  Error              Rate
Seg1   5639  2931  2189  1793 0.5507 =  6,913 / 12,552
Seg2   1455 14727  1782  4974 0.3580 =  8,211 / 22,938
Seg3    833  1306 14738  1850 0.2130 =  3,989 / 18,727
Seg4    906  5561  1927 13120 0.3902 =  8,394 / 21,514
Totals 8833 24525 20636 21737 0.3632 = 27,507 / 75,731

The hit ratio for the testing sample is 63.83%.

h2o.hit_ratio_table(fs3Cov.class_gbm, train=TRUE, valid=TRUE )

$train
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.641702
2 2  0.881629
3 3  0.970705
4 4  1.000000

$valid
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.636780
2 2  0.878768
3 3  0.970501
4 4  1.000000

6.15.2 Diagnostic statistics

The GBM model is similar to Random Forest in terms of performance across the five metrics. Again, we wouldn’t write home about it.

covH[4, 1] <- "GBM_Boosting"
covH[4, 2] <- fs3Cov.class_gbm@model$validation_metrics@metrics$hit_ratio_table$hit_ratio[1] #  
covH[4, 3] <- fs3Cov.class_gbm@model$validation_metrics@metrics$MSE   #  
covH[4, 4] <- fs3Cov.class_gbm@model$validation_metrics@metrics$RMSE       #  
covH[4, 5] <- fs3Cov.class_gbm@model$validation_metrics@metrics$ logloss
covH[4, 6] <- fs3Cov.class_gbm@model$validation_metrics@metrics$ mean_per_class_error
covH

  Prediction_model hit_ratio       MSE      RMSE   logloss mean_per_class_error
1    Random_forest 0.6360936 0.2957424 0.5438220 0.8446302            0.3783833
2              GLM 0.6247904 0.3068551 0.5539450 0.8733787            0.3893232
3    Deep_Learning 0.6237340 0.2963624 0.5443918 0.8637924            0.3912751
4     GBM_Boosting 0.6367802 0.3010183 0.5486513 0.8505309            0.3779716

6.16.1 Confusion Matrices

Training Sample

The Naive Bayes model error rate for the training sample is the highest one we’ve seen thus far for traingin samples, at 40.55%.

h2o.confusionMatrix(fs3Cov.class_nB,  fs.split[[1]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
        Seg1  Seg2  Seg3  Seg4  Error               Rate
Seg1   11363  6562  7201  3891 0.6084 =  17,654 / 29,017
Seg2    4115 28389  7269 14063 0.4727 =  25,447 / 53,836
Seg3    1736  3057 34845  4230 0.2057 =   9,023 / 43,868
Seg4    2754 10222  6587 30711 0.3891 =  19,563 / 50,274
Totals 19968 48230 55902 52895 0.4050 = 71,687 / 176,995

Testing Sample

Similarly, the Naive Bayes model error rate for the testing sample is the highest one we’ve seen thus far for testing samples, at 40.45%.

h2o.confusionMatrix(fs3Cov.class_nB,  fs.split[[2]] )

Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
       Seg1  Seg2  Seg3  Seg4  Error              Rate
Seg1   4825  2830  3184  1713 0.6156 =  7,727 / 12,552
Seg2   1764 12082  3105  5987 0.4733 = 10,856 / 22,938
Seg3    752  1230 14855  1890 0.2068 =  3,872 / 18,727
Seg4   1126  4427  2770 13191 0.3869 =  8,323 / 21,514
Totals 8467 20569 23914 22781 0.4064 = 30,778 / 75,731

The hit ratio for the testing sample is 59.55%, which is pretty poor.

h2o.hit_ratio_table(fs3Cov.class_nB, train=TRUE, valid=TRUE )

$train
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.594977
2 2  0.847035
3 3  0.959733
4 4  1.000000

$valid
Top-4 Hit Ratios: 
  k hit_ratio
1 1  0.593588
2 2  0.846021
3 3  0.958511
4 4  1.000000

6.16.2 Comparing the Five Predictive Models’ Diagnostic Statistics

covH[5, 1] <- "naive_Bayes"
covH[5, 2] <- fs3Cov.class_nB@model$validation_metrics@metrics$hit_ratio_table$hit_ratio[1] #  
covH[5, 3] <- fs3Cov.class_nB@model$validation_metrics@metrics$MSE   #  
covH[5, 4] <- fs3Cov.class_nB@model$validation_metrics@metrics$RMSE       #  
covH[5, 5] <- fs3Cov.class_nB@model$validation_metrics@metrics$ logloss
covH[5, 6] <- fs3Cov.class_nB@model$validation_metrics@metrics$ mean_per_class_error

The Random Forest model is slightly superior than the other models overall, however, the hit ratio is nothing to be proud of. The Naive Bayes model seems to be the worst model.

pacman::p_load(sjPlot)
tab_df(covH, sort.column = -2, show.rownames = FALSE, digits = 3,
       title = "Statistics of five Level 2 models of the 6-segment solution")

6.16.3 Graphically Comparing The Hit Ratios

As you can see the hit ratios are all quite similar and poor.

pacman::p_load(reshape2)
# covH[,1:2] 
hits_long<- melt(covH[,1:2] ) # need to reshape to 'long' form
# head(hits_long )
pacman::p_load(ggplot2)
ggplot(data=hits_long, aes(x= reorder(Prediction_model, -value), y=value ) ) +
  geom_bar(  stat="identity" , fill = "pink", width = 0.3) +
  geom_point(aes( color= Prediction_model ), size=3) +
  theme(axis.text.x = element_text(angle = 0, hjust = 1, size=10)) +
  labs( title= "Hit ratios for predictive models using covariates" , 
        y= "Proportion correct", x= "Prediction Model") +
  ylim(0, 1)

6.16.4 Obtaining the segment assignments using the random forest model

Here we are predicting each respondents’ segment based on the fs3Cov.class_rf model (demographic varibales only).

cov.assign.hex = h2o.predict(fs3Cov.class_rf, fs4C.class[,18:34]) 
#cov.assign.hex<- as.factor(cov.assign.hex) # cluster 'names' must be factors for modeling
h2o.print(cov.assign.hex$predict, n = 10L)
h2o.table(cov.assign.hex$predict) # table of assignments over all respondents

6.18.1 Table of Attribute Attitudes and Segments

The table below lists the means for each attitudinal variable for those in each of the 4 Level 1 Segments.

Top 3 most important variables in each segment:

Segment 1 Top 3:

• Trust Financial/Banking Applications
• Technology Enthusiast Per Household
• Consent in sharing Mobile Information per HouseHold

Segment 2 Top 3:

• Trust Financial/Banking Applications
• Annual Premiums Paid for Home Insurance per HouseHold
• Technology Enthusiast People Per Household

Segment 3 Top 3:

• Trust Financial/Banking Applications
• Technology Enthusiast Per Household
• Smart Thermostat Owners per HouseHold & Confidence in Big Business per HouseHold

Segment 4 Top 3:

• Trust Financial/Banking Applications
• Annual Premiums Paid for Home Insurance Per HouseHold
• Smart Home Assistant Owners per HouseHold

library("dplyr")
library("kableExtra")
Customer_Data <- read.csv("C:/Jaspreet Marketing Analytics Project/FS.4Seg.L1.L2_16dec20.csv")
library(psych)
library(data.table)

Customer_Data %>% 
  mutate(Group = as.factor(L1_Segments)) %>%
  group_by(Group) %>%
  summarize(Avg_er = round(mean(Confidence),2), 
            Avg_ps = round(mean(Tech.Enthu.),2), 
            Avg_fo = round(mean(Ann_Prem_Hm_Insu),2),
            Avg_tp = round(mean(Mob_Mark_cons),2),
            Avg_sc = round(mean(Mob_Inf_sec_cons),2),
            Avg_sr = round(mean(X..Smart_purch),2),
            Avg_os = round(mean(X.Smt_Therm),2),
            Avg_ca = round(mean(X.Smt_Hm_Secu),2),
            Avg_c = round(mean(X.Smt_Hm_Ass),2),
            Avg_f = round(mean(Smt_Hm_Dev),2),
            Avg_h = round(mean(X.Smat_Therm.Pln),2),
            Avg_i = round(mean(X.Smt_Hm_Sec.Pln),2),
            Avg_j = round(mean(X.Smt_Hm_Asst.Pln),2),
            Avg_k = round(mean(X.Smt_Hm_Dev.Pln),2),
            Avg_l = round(mean(Fin_App_Trst),2),
            Count_of_Members = n()
  ) %>%
  arrange(Group) %>% 
  transpose() -> cd

colnames(cd) <-  cd[1,] 
cd <- cd[-1,]
cd$order <- 1:nrow(cd)
cd$order

 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16

rownames(cd)[1:15] <- colnames(Customer_Data[c(1,4:17)])
rownames(cd)[16] <- c("Segment_Size")
# cd$variable <- rownames(cd)
cd$variable <- c("Confidence in Big Business per HouseHold- RBC",
                 "Technology Enthusiast People per HouseHold",
                 "Annual Premiums Paid for Home Insurance per HouseHold",
                 "Consent in Mobile Marketing per HouseHold",
                 "Consent in sharing Mobile Information per HouseHold",
                 "Per HouseHold people purchasing through smartphones",
                 "Smart Thermostat Owners per HouseHold",
                 "Smart Home Security Owners per HouseHold",
                 "Smart Home Assistant Owners per HouseHold",
                 "Smart Home Devices Owners per HouseHold",
                 "People planning to buy Smart Thermostat per HouseHold",
                 "People planning to buy Smart Home Security devices per HouseHold",
                 "People planning to buy Smart Home Assistant per HouseHold",
                 "People planning to buy Smart Home Devices per HouseHold",
                 "People having Financial Application Trust per HouseHold",
                 "Segment Size")
cd <- cd[, c(6, 1:5)]
cd[,2:5] <- lapply(cd[,2:5], function(x) as.numeric(as.character(x)))
cd[1:15, 1:5] %>% 
  arrange(variable) %>% 
  mutate_if(is.numeric, function(x) {
    cell_spec(x, bold = T, 
              color = spec_color(x, end = 0.9),
              font_size = spec_font_size(x))
  }) %>%
  kable(escape = F, align = "c") %>%
  kable_styling(c("striped", "condensed"), full_width = T, position = "left")

Although the L2 segmentation wasn’t that impressive, we went ahead and looked at segments in further granularity to see if we could pick anything up that it interesting and could add value.

6.18.2 Correspondence Analysis of Attributes and Segments

library(FactoMineR)
cd.m <- cd[1:15, 2:5]
cd.m

                  Seg1 Seg2 Seg3 Seg4
Confidence        0.20 0.20 0.27 0.23
Tech.Enthu.       0.26 0.18 0.25 0.21
Ann_Prem_Hm_Insu  0.16 0.22 0.18 0.29
Mob_Mark_cons     0.14 0.12 0.15 0.13
Mob_Inf_sec_cons  0.21 0.16 0.19 0.19
X..Smart_purch    0.19 0.11 0.18 0.13
X.Smt_Therm       0.15 0.15 0.27 0.19
X.Smt_Hm_Secu     0.08 0.06 0.13 0.07
X.Smt_Hm_Ass      0.19 0.17 0.26 0.21
Smt_Hm_Dev        0.11 0.09 0.16 0.12
X.Smat_Therm.Pln  0.09 0.08 0.11 0.10
X.Smt_Hm_Sec.Pln  0.10 0.09 0.16 0.11
X.Smt_Hm_Asst.Pln 0.08 0.06 0.11 0.08
X.Smt_Hm_Dev.Pln  0.10 0.08 0.13 0.10
Fin_App_Trst      0.46 0.39 0.43 0.47

c <- CA(cd.m, graph=FALSE)
plot(c, title="Correspondence Analysis of Attributes and Segments", col.main="blue" )

6.18.3 Interpreting the Segments Using Demographic Data

The several tables that follow provide the row and column percents for each level of each demographic for the 4 Level 1 segments. While prediction using the demographic variables has been shown to be very poor, there may be some insights that could help to better describe the segments.

The Chi-square statistics beneath each table provide some indication of whether the table shows any significant relationship between the variables and the segments.

The blue/purple numbers represent the across-segment percentages The green numbers represent the within-segment percentages.

6.18.4 Segments by Total Population Age

• Segment 1: 96% of them are within the age bracket of 26-64.
• Segment 2: 58% of them are within the age bracket of 40-64.
• Segment 3: 52% of them are within the age bracket of 40-64.
• Segment 4: Skewing older…78.3% are 40-64.

library(sjPlot)
sjt.xtab(Customer_Data$Pop_Age, Customer_Data$L1_Segments,
         show.row.prc = TRUE, show.col.prc = TRUE)

6.18.5 Segments by Male Population Age

sjt.xtab(Customer_Data$M_Pop_Age, Customer_Data$L1_Segments,
         show.row.prc = TRUE, show.col.prc = TRUE)

6.18.6 Segments by Female Population Age

#__THE LEVELS WILL NOT PRINT IN ORDER UNLESS WE PHYSICALLY ORDER THEM
library(forcats)
Customer_Data$F_Pop_Age <- fct_relevel(Customer_Data$F_Pop_Age)
levels(Customer_Data$F_Pop_Age)

[1] "0-25 Years"         "26-50 Years"        "51-75 Years"       
[4] "More than 76 Years"

sjt.xtab(Customer_Data$F_Pop_Age, Customer_Data$L1_Segments,
         show.row.prc = TRUE, show.col.prc = TRUE)

6.18.7 Segments by Private Household

Overall, it appears that the majority of people in each segments live in 3-4 family households.

• Segment 1: 60% of this segment lives in 3-4 person households.
• Segment 2: 80% of this segment lives in 3-4 person households.
• Segment 3: 72.3% of this segment lives in 3-4 person households.
• Segment 4: 73.1% of this segment lives in 3-4 person households. Roughly half of the 0-2 person households who were surveyed fall into Segment 4.

#__THE LEVELS WILL NOT PRINT IN ORDER UNLESS WE PHYSICALLY ORDER THEM
library(forcats)
Customer_Data$Pvt_HHld <- fct_relevel(Customer_Data$Pvt_HHld)
levels(Customer_Data$Pvt_HHld)

[1] "0-2 Persons Private Households" "3-4 Persons Private Households"
[3] "5-6 Persons Private Households" "7-8 Persons Private Households"
[5] "8+ Persons Private Households" 

sjt.xtab(Customer_Data$Pvt_HHld, Customer_Data$L1_Segments,
         show.row.prc = TRUE, show.col.prc = TRUE)

6.18.8 Segments by Family Household

Unfortunately, this variable did not yield helpful results that can be interpreted. It is on a per-postal-code basis and if we divided by the total population, the numbers were less than 1.

#__THE LEVELS WILL NOT PRINT IN ORDER UNLESS WE PHYSICALLY ORDER THEM
library(forcats)
Customer_Data$Fam_Hhld <- fct_relevel(Customer_Data$Fam_Hhld)
levels(Customer_Data$Fam_Hhld)

[1] "0-5 Family Households"   "11-15 Family Households"
[3] "16-20 Family Households" "21-25 Family Households"
[5] "26-30 Family Households" "31-35 Family Households"
[7] "36-40 Family Households" "40+ Family Households"  
[9] "6-10 Family Households" 

sjt.xtab(Customer_Data$Fam_Hhld, Customer_Data$L1_Segments,
         show.row.prc = TRUE, show.col.prc = TRUE)

6.18.9 Segments by Non-Family Household

Unfortunately, this variable did not yield helpful results that can be interpreted. It is on a per-postal-code basis and if we divided by the total population, the numbers were less than 1.

sjt.xtab(Customer_Data$NF_Hhld, Customer_Data$L1_Segments,
         show.row.prc = TRUE, show.col.prc = TRUE)

6.18.10 Segments by Average Child per census family household

Overall, 50% of households have 2 children across all segments.

• Segment 1: 90% of this segment has 1-2 children/ household.
• Segment 3: 75.2% of this segment has 2 children/ household.
• Segment 4: 68.5% of this segment has 1 children/ household.

sjt.xtab(Customer_Data$Avg_Chld_PrCen_Fm_Hhld, Customer_Data$L1_Segments,
         show.row.prc = TRUE, show.col.prc = TRUE)